home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
COMPILER
/
VP10B003
/
VPC.ZIP
/
SOURCE
/
RTL
/
DOS.INC
< prev
next >
Wrap
Text File
|
1995-06-22
|
8KB
|
239 lines
{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Runtime Library. Version 1.0. █}
{█ Dos/WinDos common procedures and functions █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 1995 B&M&T Corporation █}
{█ ─────────────────────────────────────────────────█}
{█ Written by Vitaly Miryanov █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{ Returns the OS/2 version number. The low byte of the result is the }
{ major version number, and the high byte is the minor version number. }
{ For example, OS/2 2.10 returns $0A14, i.e. 20 in the low byte, and 10 }
{ in the high byte. }
function DosVersion: Word;
var
Version: array [0..1] of Longint;
begin
DosQuerySysInfo(qsv_Version_Major,qsv_Version_Minor,Version,SizeOf(Version));
DosVersion := Version[0] + Version[1] shl 8;
end;
{ Returns the current date set in the operating system. Ranges of the }
{ values returned are: Year 1980-2099, Month 1-12, Day 1-31 and }
{ DayOfWeek 0-6 (0 corresponds to Sunday). }
procedure GetDate(var Year,Month,Day,DayOfWeek: Word);
var
DT: Os2Base.DateTime;
begin
DosGetDateTime(DT);
Year := DT.Year;
Month := DT.Month;
Day := DT.Day;
DayOfWeek := DT.WeekDay;
end;
{ Sets the current date set in the operating system. Valid parameter }
{ ranges are: Year 1980-2099, Month 1-12 and Day 1-31. If the date is }
{ not valid, the function call is ignored. }
procedure SetDate(Year,Month,Day: Word);
var
DT: Os2Base.DateTime;
begin
DosGetDateTime(DT);
DT.Year := Year;
DT.Month := Month;
DT.Day := Day;
DosSetDateTime(DT);
end;
{ Returns the current time set in the operating system. Ranges of the }
{ values returned are: Hour 0-23, Minute 0-59, Second 0-59 and Sec100 }
{ (hundredths of seconds) 0-99. }
procedure GetTime(var Hour,Minute,Second,Sec100: Word);
var
DT: Os2Base.DateTime;
begin
DosGetDateTime(DT);
Hour := DT.Hours;
Minute := DT.Minutes;
Second := DT.Seconds;
Sec100 := DT.Hundredths;
end;
{ Sets the time in the operating system. Valid parameter ranges are: }
{ Hour 0-23, Minute 0-59, Second 0-59 and Sec100 (hundredths of seconds)}
{ 0-99. If the time is not valid, the function call is ignored. }
procedure SetTime(Hour,Minute,Second,Sec100: Word);
var
DT: Os2Base.DateTime;
begin
DosGetDateTime(DT);
DT.Hours := Hour;
DT.Minutes := Minute;
DT.Seconds := Second;
DT.Hundredths := Sec100;
DosSetDateTime(DT);
end;
{ GetVerify returns the state of the verify flag in OS/2. When off }
{ (False), disk writes are not verified. When on (True), all disk }
{ writes are verified to insure proper writing. }
procedure GetVerify(var Verify: Boolean);
var
Flag: Bool;
begin
DosQueryVerify(Flag);
Verify := Flag;
end;
{ SetVerify sets the state of the verify flag in OS/2. }
procedure SetVerify(Verify: Boolean);
begin
DosSetVerify(Verify);
end;
{ Returns the number of free bytes on the specified drive number }
{ (0=Default,1=A,2=B,..). Returns -1 if the drive number is invalid. }
function DiskFree(Drive: Byte): Longint;
var
Info: FsAllocate;
begin
if DosQueryFSInfo(Drive, fsil_Alloc, Info, SizeOf(Info)) = 0
then DiskFree := Info.cUnitAvail * Info.cSectorUnit * Info.cbSector
else DiskFree := -1;
end;
{ Returns the size in bytes of the specified drive number (0=Default, }
{ 1=A,2=B,..). Returns -1 if the drive number is invalid. }
function DiskSize(Drive: Byte): Longint;
var
Info: FsAllocate;
begin
if DosQueryFSInfo(Drive, fsil_Alloc, Info, SizeOf(Info)) = 0
then DiskSize := Info.cUnit * Info.cSectorUnit * Info.cbSector
else DiskSize := -1;
end;
{ Returns the attributes of a file. F must be a file variable (typed, }
{ untyped or textfile) which has been assigned a name. The attributes }
{ are examined by ANDing with the attribute masks defined as constants }
{ above. Errors are reported in DosError. }
procedure GetFAttr(var F; var Attr: Word);
var
Info: FileStatus3;
begin
DosError := DosQueryPathInfo(FileRec(F).Name,fil_Standard,Info,SizeOf(Info));
If DosError = 0 then Attr := Info.attrFile else Attr := 0;
end;
{ Sets the attributes of a file. F must be a file variable (typed, }
{ untyped or textfile) which has been assigned a name. The attribute }
{ value is formed by adding (or ORing) the appropriate attribute masks }
{ defined as constants above. Errors are reported in DosError. }
procedure SetFAttr(var F; Attr: Word);
var
Info: FileStatus3;
begin
DosError := DosQueryPathInfo(FileRec(F).Name,fil_Standard,Info,SizeOf(Info));
if DosError = 0 then
begin
Info.attrFile := Attr;
DosError := DosSetPathInfo(FileRec(F).Name,fil_Standard,Info,SizeOf(Info),dspi_WrtThru);
end;
end;
{ Type cast record }
type
DateTimeRec = record
FTime,FDate: SmallWord;
end;
{ Returns the date and time a file was last written. F must be a file }
{ variable (typed, untyped or textfile) which has been assigned and }
{ opened. The Time parameter may be unpacked throgh a call to }
{ UnpackTime. Errors are reported in DosError. }
procedure GetFTime(var F; var Time: Longint);
var
Info: FileStatus3;
FDateTime: DateTimeRec absolute Time;
begin
DosError := DosQueryFileInfo(FileRec(F).Handle,fil_Standard,Info,SizeOf(Info));
if DosError <> 0 then Time := 0
else
with FDateTime do
begin
FTime := Info.ftimeLastWrite;
FDate := Info.fdateLastWrite;
end
end;
{ Sets the date and time a file was last written. F must be a file }
{ variable (typed, untyped or textfile) which has been assigned and }
{ opened. The Time parameter may be created through a call to PackTime. }
{ Errors are reported in DosError. }
procedure SetFTime(var F; Time: Longint);
var
Info: FileStatus3;
FDateTime: DateTimeRec absolute Time;
begin
DosError := DosQueryFileInfo(FileRec(F).Handle,fil_Standard,Info,SizeOf(Info));
if DosError <> 0 then Time := 0
else
with FDateTime do
begin
Info.ftimeLastWrite := FTime;
Info.fdateLastWrite := FDate;
DosError := DosSetFileInfo(FileRec(F).Handle,fil_Standard,Info,SizeOf(Info));
end
end;
{ Converts a 4-byte packed date/time returned by FindFirst, FindNext or }
{ GetFTime into a DateTime record. }
procedure UnpackTime(P: Longint; var T: DateTime);
var
FDateTime: DateTimeRec absolute P;
begin
with T,FDateTime do
begin
Year := (FDate and mfdYear ) shr sfdYear + 1980;
Month := (FDate and mfdMonth ) shr sfdMonth;
Day := (FDate and mfdDay ) shr sfdDay;
Hour := (FTime and mftHours ) shr sftHours;
Min := (FTime and mftMinutes) shr sftMinutes;
Sec := ((FTime and mftTwoSecs) shr sftTwoSecs) * 2;
end;
end;
{ Converts a DateTime record into a 4-byte packed date/time used by }
{ SetFTime. }
procedure PackTime(var T: DateTime; var P: Longint);
var
FDateTime: DateTimeRec absolute P;
begin
with T,FDateTime do
begin
FDate := (Year - 1980) shl sfdYear + Month shl sfdMonth + Day shl sfdDay;
FTime := Hour shl sftHours + Min shl sftMinutes + (Sec div 2) shl sftTwoSecs;
end;
end;